home *** CD-ROM | disk | FTP | other *** search
- unit ShadowForm;
-
- interface
-
- uses
- Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
- StdCtrls, ComCtrls, ExtCtrls;
-
- type
- TForm1 = class(TForm)
- Panel1: TPanel;
- Image1: TImage;
- procedure FormClick(Sender: TObject);
- procedure FormCreate(Sender: TObject);
- procedure FormResize(Sender: TObject);
- private
- { Private declarations }
- ShadowWidth: Integer;
- RightShadow: TForm;
- BotShadow: TForm;
- procedure WMWindowPosChanged (var Message: TWMWindowPosChanged); message wm_WindowPosChanged;
- public
- { Public declarations }
- end;
-
- var
- Form1: TForm1;
-
- implementation
-
- {$R *.DFM}
-
- const
- // LWA constants for SetLayeredWindowAttributes
- lwa_ColorKey = 1;
- lwa_Alpha = 2;
-
- // New extended window style for layering
- ws_Ex_Layered = $80000;
-
- function SetLayeredWindowAttributes (Wnd: hWnd; crKey: ColorRef; bAlpha: Byte; dwFlags: DWord): Bool; stdcall;
- external 'user32.dll';
-
- procedure TForm1.FormClick(Sender: TObject);
- begin
- Close;
- end;
-
- procedure TForm1.FormCreate(Sender: TObject);
- begin
- ShadowWidth := 7;
- RightShadow := TForm.Create (Self);
- RightShadow.Parent := Application.MainForm;
- RightShadow.BorderStyle := bsNone;
- RightShadow.Width := ShadowWidth;
- RightShadow.Color := clBlack;
- RightShadow.Visible := True;
- SetWindowLong (RightShadow.Handle, gwl_ExStyle, GetWindowLong (RightShadow.Handle, gwl_ExStyle) or ws_Ex_Layered);
- SetLayeredWindowAttributes (RightShadow.Handle, 0, 150, lwa_Alpha);
-
- BotShadow := TForm.Create (Self);
- BotShadow.Parent := Application.MainForm;
- BotShadow.BorderStyle := bsNone;
- BotShadow.Height := ShadowWidth;
- BotShadow.Color := clBlack;
- BotShadow.Visible := True;
- SetWindowLong (BotShadow.Handle, gwl_ExStyle, GetWindowLong (BotShadow.Handle, gwl_ExStyle) or ws_Ex_Layered);
- SetLayeredWindowAttributes (BotShadow.Handle, 0, 150, lwa_Alpha);
-
- FormResize (Sender);
- end;
-
- procedure TForm1.WMWindowPosChanged (var Message: TWMWindowPosChanged);
- begin
- Inherited;
- if Assigned (RightShadow) and RightShadow.Visible then FormResize(Nil);
- end;
-
- procedure TForm1.FormResize(Sender: TObject);
- begin
- RightShadow.Height := Height;
- RightShadow.Left := Left + Width;
- RightShadow.Top := Top + ShadowWidth;
-
- BotShadow.Width := Width - ShadowWidth;
- BotShadow.Left := Left + ShadowWidth;
- BotShadow.Top := Top + Height;
- end;
-
- end.
-